COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	MAP
C00009 ENDMK
C⊗;
;MAP

MAPMES:	ASCIZ /FSUSE   FSFREE  FSTOT   DIR     PAGE    ATT     FSBEG
 /
MAPHED:	ASCIZ /
        0       1       2       3       4       5       6       7 
/
DSKMAP←←6

IMPURE

MAPILE:	SIXBIT /ETVMAP/
	SIXBIT /001   /
	0
	SIXBIT /  EALS/

PURE

MAPEXT:	SIXBIT /001   /
MAPPPN:	SIXBIT /  EALS/

MAPCR:	TYPCHR "
"					;New line needed
	MOVEI D,100			;Allow 64 on a line
	ADDI E,100
	TRNE E,777
	JRST MAPCR2
	TYPCHR "
"
	OUT DSKMAP,[-200,,CMDBUF-1↔0]
	SKIPA
	JRST MAPT2
	MOVE A,[440700,,CMDBUF]		;Use this buffer to accumulate text
	SETZM	CMDBUF
	MOVE	T,[CMDBUF,,CMDBUF+1]
	BLT	T,CMDBUF+177	;Clear the buffer
	MOVE A,[POINT 7,CMDBUF]
	TYPOCT E
	TYPCHR "	"		;A TAB
	POPJ P,

MAPT2:	MOVE T,MAPILE+1		;If file exists create a new name
	ADD T,[1,,0]
	MOVEM T,MAPILE+1
	CLOSE DSKMAP
	JRST MAPIT		;Try again

;Code to make a map of free storage
MAP:	
	MOVEM 17,SAVEAC+17
	MOVEI 17,SAVEAC
	BLT 17,SAVEAC+16
	MOVE P,SAVEAC+17	;No reason to make another push-down list

	MOVE T,MAPEXT		;Start with EXT of 001
	MOVEM T,MAPILE+1
MAPIT:	OPEN DSKMAP,[17↔'DSK   '↔0]
	PUSHJ P,TELLZ
	MOVE T,MAPPPN
	MOVEM T,MAPILE+3	;This must be reset
	LOOKUP DSKMAP,MAPILE
	JRST .+2		;Assume that it does not exist
	JRST MAPT2		;This name is already used
	ENTER DSKMAP,MAPILE
	JRST MAPT2

	SETZM	CMDBUF
	MOVE	T,[CMDBUF,,CMDBUF+1]
	BLT	T,CMDBUF+177	;Clear the buffer
	MOVE A,[440700,,CMDBUF]		;Use this buffer to accumulate text

	PUSHJ P,FILEID			;Get file identification data
	MOVE B,[POINT 7,MAPMES]
	PUSHJ P,CHTEXT			;Print labels
	MOVE T,FSUSE			;Cells occupied
	PUSHJ P, NUMSTR
	MOVEI E,11
	IDPB E,A
	MOVE T,FSFREE			;Cells free
	PUSHJ P, NUMSTR
	IDPB E,A
	MOVE T,FSMAX
	SUB T,FSMIN
	PUSHJ P, NUMSTR			;Total number of cells in  free storage
	IDPB E,A
	MOVE T,DIR
	SUB T,FSMIN
	PUSHJ P,NUMSTR			;Relative start of Directory cells
	IDPB E,A
	MOVE T,PAGE
	SUB T,FSMIN
	PUSHJ P,NUMSTR			;Relative start of page cells
	IDPB E,A
	MOVE T,ATTBUF
	SUB T,FSMIN
	PUSHJ P,NUMSTR			;Relative start of ATTBUF
	IDPB E,A
	MOVE T,FSBEG
	SUB T,FSMIN
	PUSHJ P, NUMSTR			;Relative start of FRFREE
	MOVE B,[POINT 7,MAPHED]
	PUSHJ P, CHTEXT

	MOVEM A,TYOPNT			;Prime for TYPCHR 
	MOVEI B,FSMIN			;Start at beginning of free storage
	MOVEI D,100			;Allow 64 cells per line in map
	MOVEI E,0			;Used for cell count
	TYPDEC E
	TYPCHR "	"		;A TAB
MAP1:	HRRZ T,(B)			;Get the number of words for this line
	MOVE TT,B
	ADD TT,T			;This will be the new B
	CAME T,-1(TT)			;Check the two end counts
	JRST MAP3			;We're in trouble
MAP2:	HLRZ C,(B)			;Get identifying info
	CAIN C,1			;Is it a directory line?
	JRST [TYPCHR "D"↔SOJA T,MAP4]	;Yes
	CAIN C,2			;Or maybe text?
	JRST [TYPCHR "T"↔SOJA T,MAP4]	;Yes
	CAIN C,777777			;Surely must be empty then?
	JRST [TYPCHR "E"↔SOJA T,MAP6]	;Yes
;Something is wrong, try to fix
MAP3:	MOVE G,B
MAP3A:	TYPCHR "?"
	SOSG D
	PUSHJ P,MAPCR
	ADDI G,1
	CAML G,FSMAX
	JRST MAP9			;We are at the end of free storage
	HLRZ C,(G)
	CAIE C,1
	CAIN C,2
	JRST MAP3B			;Maybe this is it
	CAIE C,777777
	JRST MAP3A			;Still may be it
MAP3B:	HRRZ T,(G)
	MOVE TT,G
	ADD TT,T
	CAME T,-1(TT)
	JRST MAP3A			;Still no good
	MOVE B,G			;We are back in step
	JRST MAP1


MAP3:		;We're in trouble, find out why


MAP4:	SOSG D
	PUSHJ P,MAPCR
	TYPCHR "+"
MAP5:	SOJG T,MAP4
	JRST MAP8

MAP6:	SOSG D
	PUSHJ P,MAPCR
	TYPCHR " "
MAP7:	SOJG T,MAP6
MAP8:	SOSG D
	PUSHJ P,MAPCR
	MOVE B,TT			;Get ready for the next line
	CAMGE B,FSMAX			;Are we through?
	JRST MAP1			;No
MAP9:	OUT DSKMAP,[-200,,CMDBUF-1↔0]
	SKIPA
	JFCL
	CLOSE DSKMAP,
	RELEAS DSKMAP,
	MOVSI 17,SAVEAC
	BLT 17,17
	POPJ P,

MAPT2:	MOVE T,MAPILE+1		;If file is busy create a new one
	ADD T,[1,,0]
	MOVEM T,MAPILE+1
	CLOSE DSKMAP,
	JRST MAPIT		;Try again